#lang rosetta-racket


(provide crater-tessellation)


(define (rectangle-line p1 p2 p3 p4)
  (join
   (spline (list p1 p2))
   (spline (list p2 p3))
   (spline (list p3 p4))
   (spline (list p4 p1))))

(define (crater c n p1 p2 p3 p4 radius)
  (loft
   (list
    (rectangle-line p1 p2 p3 p4)
    (move (+c c (*c n (* 0.1 radius))) (circle-n radius n))
    (move (+c c (*c n (* 0.8 radius))) (circle-n (* 0.7 radius) n))
    (move (+c c (*c n (* -0.1 radius))) (circle-n (* 0.4 radius) n)))))

(define (crater-tessellation skin n-u n-v)
  (map
   (λ (patch)
     (let ((p1 (patch-object patch (u-fn-min) (v-fn-min)))
           (p2 (patch-object patch (u-fn-max) (v-fn-min)))
           (p3 (patch-object patch (u-fn-max) (v-fn-max)))
           (p4 (patch-object patch (u-fn-min) (v-fn-max))))
       (crater
        (patch-object patch (u-fn-half) (u-fn-half))
        (patch-normal patch (u-fn-half) (u-fn-half))
        p1 p2 p3 p4
        (* 0.4 (min
                (xyz-r (-c p1 p2))
                (xyz-r (-c p1 p4)))))))
   (cut skin (list n-u n-v))))